home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 181 / 181.d81 / brass ring (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  22KB  |  684 lines
  1. 1 rem copyrighted by maurice jones, november  1996
  2. 2 nm$="brass ring":nn$="amcgs":    dv=peek(186):ifdv<8thendv=8
  3. 3 print"[159][147]":poke53280,0:poke53281,0:poke788,49:tq=ti:poke53371,0:mt=49152
  4. 4 sys57812"amcgs.a font",dv,0:poke780,0:poke781,0:poke782,8:sys65493
  5. 12 open2,dv,2,nm$+".opts,p,r":input#2,k3,sd,so,cc,sk
  6. 14 input#2,bd,fb,mu,wg,pk,rd,kc,kc%(0):close2
  7. 17 gosub5500:poke53265,27:onmu+1goto500,482
  8. 18 :
  9. 19 rem brancher
  10. 20 onsd+1goto70,80
  11. 24 :
  12. 25 rem charge
  13. 26 a$="251331421502421502":poke53370,0
  14. 27 t=87:pokef+6,96:pokef+24,15
  15. 28 fori=1to18step3
  16. 29 pokef+1,val(mid$(a$,i,2)):pokef+4,33
  17. 30 forj=1tot*val(mid$(a$,i+2,1)):next
  18. 31 pokef+4,0:next:fori=ftof+24
  19. 32 pokei,0:next:poke53371,0:return
  20. 34 rem menu brancher
  21. 35 sysmt:poke53269,1
  22. 37 sysmt+9:ifl2%then57
  23. 41 i=1:geta$:ifa$=""then37
  24. 45 ifi>len(ch$)then37
  25. 49 ifa$=mid$(ch$,i,1)then59
  26. 53 i=i+1:goto45
  27. 57 ifcx%<x1+2orcx%>x2-2orcy%<y1+3orcy%>y2-1then37
  28. 58 i=(cy%-(y1)-1)/2
  29. 59 return
  30. 63 :
  31. 64 rem print at
  32. 65 x=x(i):y=y(i)
  33. 66 poke211,x:poke214,y:sys58732:return
  34. 68 :
  35. 69 rem keybord brancher
  36. 70 i=1:geta$:ifa$=""then76
  37. 71 ifi>len(ch$)then70
  38. 72 ifa$=mid$(ch$,i,1)thenreturn
  39. 73 i=i+1:goto71
  40. 76 ifjj=nc-2thenjj=-1
  41. 77 jj=jj+1:j%=jj+int(rnd(1)*(nc-jj)):temp=s(jj):s(jj)=s(j%):s(j%)=temp:goto70
  42. 78 :
  43. 79 rem mouse brancher
  44. 80 sysmt+9:ifl2%=1orr2%=1 theni=rg%:return
  45. 81 ifjj=nc-2thenjj=-1
  46. 82 jj=jj+1:j%=jj+int(rnd(1)*(nc-jj)):temp=s(jj):s(jj)=s(j%):s(j%)=temp:goto 80
  47. 88 :
  48. 89 rem wrong choice sound
  49. 90 poke53370,0:pokef+24,15:pokef+8,4:pokef+12,63:pokef+13,17:pokef+11,33
  50. 91 fori=1to100:next:pokef+11,32
  51. 92 y= 1:x= 0  :gosub66:printwm$(wm);:fori=1to150:next
  52. 93 poke53371,0:return
  53. 94 :
  54. 95 rem tone & message
  55. 96 poke53370,0:pokef+24,15:pokef+5,4:pokef+6,12
  56. 97 pokef+4,23:pokef+15,100:pokef+4,20:pokef+1,30:fork=1to350:next:pokef+6,0
  57. 98 pokef+4,129:goto92
  58. 109 :
  59. 110 rem special turn from deck  not a sub
  60. 111 tc=b%(t2,c(t2)):ts=fns(tc):tv=fnv(tc)
  61. 115 gosub270:onplgoto119,640
  62. 119 ift2>sf+3orgf=sf+3thenwm=3:gosub90:goto534
  63. 120 t2=t2+4:goto620
  64. 121 :
  65. 122 rem auto
  66. 123 tc=b%(t2,c(t2)):ts=fns(tc):tv=fnv(tc)
  67. 127 gosub270:onplgoto141,131
  68. 131 fork=c(fr)-1to1step-1
  69. 133 iffns(b%(fr,k))<>fsthen139
  70. 135 iffnv(b%(fr,k))<>fnv(b%(fr,k+1))+1then139
  71. 137 nextk
  72. 139 mm=k+1:goto1240
  73. 141 ift2>sf+3orgf=sf+3thenwm=3:gosub90:goto534
  74. 143 t2=t2+4:goto123
  75. 149 :
  76. 150 rem fill empty spaces
  77. 151 iffr<=2or(c(0)=0andc(1)=0)then534
  78. 154 ifc(2)>0then164
  79. 155 ifc(1)>0then160
  80. 156 c(fr)=c(fr)+1:b%(fr,c(fr))=b%(0,c(0)):c(0)=c(0)-1:i=0:gosub250:gosub230
  81. 157 ifc(0)=0thensysmt+30,x(0),x(0)+3,y(0),y(0)+4,kt,sk
  82. 158 i=fr:gosub200:goto534
  83. 160 c(fr)=c(fr)+1:b%(fr,c(fr))=b%(1,c(1)):c(1)=c(1)-1:i=1:gosub200
  84. 162 goto158
  85. 164 c(fr)=c(fr)+1:b%(fr,c(fr))=b%(2,c(2)):c(2)=c(2)-1:i=2
  86. 165 ifc(2)=0theni=2:gosub65: gosub224:gosub230:goto158
  87. 166 gosub250:gosub230: goto158
  88. 168 :
  89. 169 rem erases pile i
  90. 170 ifks(i)=2then174
  91. 172 mx=y(i)+sp(i)*(mx(i)-1)+4:sysmt+30,x(i),x(i)+3,y(i),mx,kt,sk:goto177
  92. 174 mx=x(i)+sp(i)*(mx(i)-1)+3:sysmt+30,x(i),mx,y(i),y(i)+4,kt,sk
  93. 177 return
  94. 178 :
  95. 179 rem magic :202 other place  203:any card
  96. 180 onks(i)goto181,190
  97. 181 x=x(i):y=y(i)+sp(i)*(c(i)-1)
  98. 182 ify>y(i)+sp(i)*(mx(i)-1)theny=y(i)+sp(i)*(mx(i)-1)
  99. 184 gosub66:goto202
  100. 190 y=y(i):x=x(i)+sp(i)*(c(i)-1)
  101. 192 ifx>x(i)+sp(i)*(mx(i)-1)thenx=x(i)+sp(i)*(mx(i)-1)
  102. 194 gosub66:goto202
  103. 200 x=x(i):y=y(i):gosub66:ifc(i)=0thengosub170
  104. 202 ca=b%(i,c(i)):ifc(i)=0then224
  105. 203 poke53370,0:ifso=1then220
  106. 214 pokef+1,50:pokef+24,12:pokef+4,129:fort=1to15:next:pokef+4,128:pokef+5,0
  107. 220 print"[146]";:printst$(ca);:poke53371,0:return
  108. 224 sysmt+30,x,x+3,y,y+4,kt,sk:return
  109. 228 :
  110. 229 rem print count at i
  111. 230 k=len(str$(c(i))):sysmt+30,x(i)-2,x(i)-1,y(i)+3,y(i)+3,kt,sk
  112. 234 ifc(i)=0then246
  113. 236 x=x(i)-k+1:y=y(i)+3
  114. 238 gosub66:print"[156]"right$(str$(c(i)),k-1):return
  115. 244 gosub66:print"[156]"right$(str$(c(i)-1),k-1):return
  116. 246 ifi=0andc(0)=0andre<kdthensysmt+36,7,255,15:return
  117. 247 ifc(0)=0then  sysmt+30,x(0),x(0)+3,y(0),y(0)+4,kt,sk:return
  118. 248 : return
  119. 249 rem prints deck at i
  120. 250 print"[146]":gosub65
  121. 252 poke53370,0:ifso=1then256
  122. 254 pokef+1,50:pokef+24,12:pokef+4,129:fort=1to15:next:pokef+4,128:pokef+5,0
  123. 256 poke646,cc:printbk$:sysmt+30,x+1,x+2,y+1,y+3,kc%(kc),cc:poke53371,0:return
  124. 258 :
  125. 259 rem redeal
  126. 260 kd=fl(2):ifrd=0thenkd=fl(3)
  127. 261 ifre= kdthenwm=9:gosub90:return
  128. 262 x=c(1):fori=1tox:b%(0,x)=b%(1,i):x=x-1:next:c(0)=c(1):c(1)=0
  129. 263 i=1:gosub65:sysmt+30,x,x+ht+2,y,y+4,kt,sk:i=0:gosub250:gosub230
  130. 264 ifht=3thenreturn
  131. 265 re=re+1
  132. 266 return
  133. 268 :
  134. 269 will it play
  135. 270 pl=1:ifts<>fsandc(t2)>0thenreturn
  136. 271 if(t2<1ort2=2)or(t2>1andfv=0andt2<>sf+fs)thenreturn
  137. 272 ift2=1andfr=2thenreturn
  138. 273 ifc(2)>0andt2=1andfs=tsand(fv=tv+1orfv=tv-1)thenpl=2:return
  139. 274 ift2=1thenreturn
  140. 275 ift2>  2andt2<sfthenreturn
  141. 276 fori=0to4:ifpl%(t2-sf ,i)=frthen279
  142. 277 next
  143. 278 return
  144. 279 ifc(t2)=0andfv=0thenpl=2:return
  145. 280 ifc(t2)>0andtc+1=fcthenpl=2:return
  146. 282 return
  147. 288 :
  148. 289 rem play from klon type waste
  149. 290 c(t2)=c(t2)+1:b%(t2,c(t2))=b%(fr,c(fr)):c(fr)=c(fr)-1:
  150. 291 y=y(1):x=x(1)+nt-1 :gosub66
  151. 292 sysmt+30,x,x+3,y,y+4,kt,sk
  152. 294 nt=nt-1:ifnt<1thennt=1
  153. 296 i=1:y=y(1):x=x(1)+nt-1:gosub66:gosub202
  154. 297 i=t2:gosub180:return
  155. 298 :
  156. 299 rem print stats
  157. 300 x1=2:x2=15:y1=8:y2=19:cl=cc:gosub2100
  158. 302 x=x1+2:y=y1+2
  159. 306 gosub66:print"[149]played";
  160. 307 x=x1+12-len(str$(t6)):gosub66:print"[144]"t6
  161. 308 x=x1+2:y=y+2:gosub66:print"spins";
  162. 309 x=x1+12-len(str$(pn)):gosub66:print"[144]"pn
  163. 310 x=x1+2:y=y+1:gosub66:print"score";
  164. 311 x=x1+12-len(str$(fs)):gosub66:print"[144]"fs
  165. 312 x=x1+2:y=y+1:gosub66:print"ave. ";
  166. 313 x=x1+12-len(str$(ave)):gosub66:print"[144]"ave
  167. 316 x=x1+2:y=y+2:gosub66:print"[156]games";
  168. 317 x=x1+12-len(str$(g7)):gosub66:print"[144]"g7
  169. 320 x=x1+2:y=y+1:gosub66:print"[156]wins ";
  170. 321 x=x1+12-len(str$(nw)):gosub66:print"[144]"nw
  171. 326 return
  172. 328 :
  173. 329 rem clear message
  174. 330 sysmt+30,0,16,1,1,kt,sk
  175. 332 return
  176. 366 :
  177. 367 rem declare win
  178. 368 ifso=0thengosub26
  179. 370 nw=nw+1:wf=1
  180. 372 x1=21:x2=34:y1=2:y2=06:cl=2:gosub2300
  181. 374 y=y1+2:x=x1+3:gosub66:print"youwin ":return
  182. 388 :
  183. 389 rem update stats
  184. 390 g7=g7+1:t6=0:
  185. 391 fori=sftonp:t6=t6+c(i):next
  186. 392 fs=t6-pn:g8=g8+fs:av=int(g8/g7+.5):ift6<lothenlo=t6
  187. 394 ift6>hithenhi=t6
  188. 395 ifg7=1thenhi=t6:lo=t6
  189. 396 iffs<37ort6<52then399
  190. 397 nw=nw+1:ifso=0thengosub26
  191. 399 wf=0:return
  192. 408 :
  193. 409 rem alternate heading
  194. 410 ifsd=1thenpoke53269,1:return
  195. 414 fori=1to20:gosub65:print"[144][145]"mid$(sc$,i,1):next
  196. 420 poke53269,0: return
  197. 438 :
  198. 439 rem spread graphics
  199. 440 print"[146]":ifk>36then442
  200. 441 x=1:y=4:forj=1tok:gosub66:c(i)=j:gosub202:x=x+1:next:goto447
  201. 442 x=1:y=4:forj=1to36:gosub66:c(i)=j:gosub202:x=x+1:next:ifk>72then445
  202. 444 x=1:y=10:forj=37tok:gosub66:c(i)=j:gosub202:x=x+1:next:goto447
  203. 445 x=1:y=10:forj=37to72:gosub66:c(i)=j:gosub202:x=x+1:next
  204. 446 x=1:y=16:forj=73tok :gosub66:c(i)=j:gosub202:x=x+1:next
  205. 447 return
  206. 480 :
  207. 481 rem menu opening
  208. 482 gosub5000
  209. 484 onigoto500,486,488,39000
  210. 486 gosub5400:goto482
  211. 488 ifrd%(1)=0andrd%(2)=0thenwm=0:gosub330: gosub90:gosub5000:goto484
  212. 490 goto502
  213. 498 :
  214. 499 new game
  215. 500 fori=1tonc:rd%(i) =s(i-1):next:c(0)=nc:kd=fl(2):ifrd=0thenkd=fl(3)
  216. 502 sysmt+42,216:fori=1tonp:c(i)=0:next
  217. 503 sysmt:gosub410
  218. 504 fori=1tonc:b%(0,i)=rd%(i):next:c(0)=nc
  219. 506 forj=1to13:i=2:c(i)=c(i)+1:b%(i,c(i))=b%(0,c(0)):c(0)=c(0)-1
  220. 510 sysmt+30,x(2),x(2)+3,y(2),y(2)+4,kc%(kc),cc: gosub250: next:   gosub230
  221. 512 fori=lttogt:c(i)=c(i)+1:b%(i,c(i))=b%(0,c(0)):c(0)=c(0)-1:gosub200:next
  222. 524 i=0:gosub250:gosub230:pn=0:xc=0:re=0
  223. 532 fork=0tonp:mm(k)=c(k):oo(k)=b%(k,1):next: z0=re:sysmt+39,144 :pp=pn
  224. 534 gosub330:print"[146]";:wm=4
  225. 535 y= 1:x=07-(len(wm$(wm)))/2:gosub66:printwm$(wm);
  226. 537 ch$=fr$:pokev+1,28  :gosub20:ifsd=1and rg%=0thenwm=08:   gosub90:goto534
  227. 538 gosub330:ifi>6then544
  228. 540 onigoto3000,1620,850,4004,4000,534
  229. 542 wf=1:x1=21:x2=34:
  230. 543 y1=2:y2=6:cl=2:gosub2300:y=4:x=24:gosub66:print"youwin ":goto4000
  231. 544 fr=i-7  :xn=0:iffr>gfthen900
  232. 545 iffr>=sfandfr<=sf+3then1900
  233. 548 ifrd=0then556
  234. 552 fork=0tonp:mm(k)=c(k):oo(k)=b%(k,1):next:z0=re:sysmt+39,144 :pp=pn
  235. 556 ifr2%=1orfr=0then568
  236. 560 ifc(fr)=0then wm=1:gosub90:goto534
  237. 564 goto600
  238. 568 ifc(0)=0andc(1)=0thenwm=1:gosub90:goto534
  239. 572 ifc(0)=0thengosub260:goto534
  240. 576 c(1)=c(1)+1:b%(1,c(1))=b%(0,c(0)):c(0)=c(0)-1:i=1:gosub200
  241. 580 i=0:gosub230:goto534
  242. 600 gosub330:print"[146]";:wm